00100	C    *** MUSIC V FOR PDP11, AS REVISED BY LELAND SMITH ***     
00200	C *********** LIMITS ******************
00300	C 15 INST DEFINITIONS. 20 NOTES PLAYING AT ONCE. 27 DIFFERENT INS. NAMES.
00400	      DIMENSION T(50),TI(50),ITI(50)   
00500		COMMON /DEVS/ID1,ID21,JTYPE,KIN,KOUT 
00600	      COMMON I(513) /P/P(50) /FINOUT/JPEAK,IPEAK,NBUF 
00700		1 /CONV/ICONV,INIOUT,JFLNM 
00800		1 /LFUNC/LFUNC,XNFUN,PINCR  /IFIRST/IFIRST,IDT
00900		1 /GENS/GENS(3072) /LOCG/LOCG(6)
01000		DO 10 N1=1,NGENS
01100	10	LOCG(N1)=(N1-1)*LFUNC+1
01200	C  ABOVE SETS UP 6 POSSIBLE FUNCS.  NUMBER MAY BE INCREASED.
01300	C TO INCREASE NUM. OF GENS AVAILABLE ENLARGE 'GENS' BY 512 PER GEN AND
01400	C PUT PROPER NUMBER INTO 'NGENS' DATA AND 'LOCG' ARRAY SIZE.
01500	
01600	C  ISRT=DEFAULT SMPL.RATE, LFUNC=FUNC ARRAY LENGTH,
01700		DATA ISRT/10000/, LFUNC/512/, ICONV/-1/,XNFUN/511.0/,NPAR/35/,
01800		1 NINS/27/,RBLK/512.0/,LBLK/512/,NGENS/6/,PFUNC/512.0/,NLIM/700/
01900	C NPAR=NUM. OF PARAMS/INST., NINS=NUM. OF INSTS., RBLK,LBLK=LENGTH OF OUTPUT BLOCKS
02000	C NLIM=NPAR* HOW MANY NOTES CAN PLAY AT ONCE. (NPAR*20=700, RNT SIZE)
02100	
02200		COMMON /INS/INS(300),IDEF(15) /NT/RNT(700) /ROUT/ROUT(2560)
02300	C INS=(15)INSTRUMENT DEFINITIONS: EACH INST. CAN USE 15 TO 40+ SLOTS
02400	C IDEF=LOCATION TABLE: 15 INST. DEFS. POSSIBLE AT ONE TIME.
02500	C RNT=PARAM. LIST FOR CURRENTLY PLAYING NOTES. SIZE OF ARRAY SHOULD
02600	C     BE A MULTIPLE OF NPAR (35*20 CURRENTLY=20 NOTES CAN PLAY AT ONCE.)
02700	C ***** ONLY 15 DIFFERENT INS NUMBERS CAN BE USED. (1-15) ********
02800	C ROUT=OUTPUT BLOCK (B1→B5)(5*512=2560)(FITS PDP11/70 FORTRAN.)
02900		EQUIVALENCE (I1,I),(I2,I(2)),(T3,T(3)),(T2,T(2)),(P3,P(3)),
03000		1 (P4,P(4)),(I5,I(5)),(I6,I(6)),(I4,I(4)),(P2,P(2)),(I3,I(3))
03100	C   SEE BLOCK DATA FOR DEVICE NUMBERS FOR IN-OUT AND TTY.
03200		NBUF=512
03300	1000	INIOUT=-1
03400	C INIOUT IS TO INITIALIZE OUTPUT SYSTEM.
03500		IFIRST=-1
03600		IDT=1
03700	C ABOVE 2 ARE IN TRANS. ROUTINES.
03800	      JPEAK=0      
03900		IPEAK=0
04000	C IPEAK AND JPEAK USED TO TYPE OUT AMPL. INFO. LATER.
04100	      I2=1      
04200	      IF(SRATE.EQ.0)SRATE=ISRT   
04300	CCC   IF(I4.EQ.0)I4=ISRT   
04400		PINCR=PFUNC/SRATE
04500	CCC	PINCR=PFUNC/I4
04600	C ABOVE FOR AUTOMATIC P2 CONVERSION TO DURATION INCR.
04700	      MOUT=1      
04800	
04900	C     INITIALIZATION OF SECTION 
05000	5     T(1)=0.0    
05100	      DO 220 N1=1,NLIM,NPAR
05200	C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
05300	 220  RNT(N1)=-1    
05400	      DO 221 N1=1,NINS      
05500	 221  TI(N1)=90909.  
05600	
05700	C     MAIN CARD READING LOOP    
05800	  204 CALL DATA (ID21)  
05900	C ID21 IS A DSK DEVICE NUM.
06000		IF(P(1).NE.1.AND.P(1).NE.6)GO TO 200
06100	C JUMP IF A NOTE OR A FINISH
06200		IF(P2.GT.T(1))GO TO 244
06300	 200  IOP=P(1)    
06400	      IF(IOP)201,201,202 
06500	 201  CALL ERROR(1)
06600	      GO TO 204     
06700	
06800	202	IF(IOP.GT.12)GO TO 201
06900	C ERROR IF OP CODE IS TOO BIG OR <0.
07000	 203  GO TO (1,2,3,4,5,6,7,8,201,201,11,11),IOP    
07100	 11   IVAR=P3   
07200	      IVARE=IVAR+I1-4  
07300	      DO  297 N1=IVAR,IVARE      
07400	      IVARP=N1-IVAR+4    
07500	 297  I(N1)=P(IVARP)     
07600	C I HOLDS THINGS LIKE SRATE, NCHNS (CHA)
07700		IF(N1.EQ.8)NBUF=512+512*I(N1)
07800	C SET BUFFER SIZE . (512=MONO, 1024=STEREO)
07900		PINCR=PFUNC/SRATE
08000	CCC	PINCR=PFUNC/I4
08100	C ABOVE FOR AUTOMATIC P2 CONVERSION TO DURATION INCR.
08200	      GO TO 204     
08300	3	IGEN=P3   
08400		IF(P4.GT.NGENS)PAUSE ' FUNC. NUM. OUT RANGE'
08500	C ERROR 4=FUNC NUMB. OUT OF RANGE.
08600	      IF(IGEN.NE.1)GO TO 282
08700	CCC **** ONLY GEN1,GEN2 IN THIS VERSION  GO TO (281,282,283,284,285),IGEN   
08800	 281  CALLGEN1    
08900	      GO TO 204     
09000	 282  IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
09100	      CALLGEN2    
09200	      GO TO 204     
09300	7       IF(P4.LT.1)P4=1
09400	C 'SEG'     SEG F A,S A,S ...    F=FUNC NUM. A=AMPL. S=STEP (1-100)
09500		DO 430 K=4,I1,2
09600	C CONVERT STEPS 1-100 TO 0-511.
09700	430	P(K)=((P(K)-1.)/99.)*511.
09800	530	DO 630 K=I1,1,-1
09900	630	P(K+2)=P(K)
10000	C ABOVE REFORMATS FOR 'GEN' ROUTINES.
10100		P3=IOP-6
10200		P2=0
10300		I1=I1+2
10400		GO TO 3
10500	8	I1=I1+1
10600	C 'SIN'   SIN F AH, AH, ...  F=FUNC NUM.  AH=AMPL OF THAT HARMONIC.
10700		P(I1)=I1-3
10800	C GET TOTAL NUM. OF HARMONICS
10900		GO TO 530
11000	 4    IVAR=P3   
11100	      IVARE=IVAR+I1-4  
11200	      DO 296N1=IVAR,IVARE 
11300	      IVARP=N1-IVAR+4    
11400	 296  I(N1+100)=P(IVARP)
11500	      GO TO 204     
11600	6     CALL FROUT3(IDSK)
11700	CCCC  STOP 
11800		GO TO 1000
11900	
12000	C     ENTER NOTE TO BE PLAYED   
12100	 1    DO 230 N1=1,NLIM,NPAR
12200	230   IF(RNT(N1).EQ.-1)GO TO 231      
12300	      CALL ERROR(2)
12400	C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
12500		WRITE(JTYPE,1230)NINS
12600	C JTYPE IS TTY DEVICE NUMBER.
12700	      GO TO 204     
12800	1230	FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
12900	 231  M1=N1
13000	      M2=N1+I1-1
13100	      M3=M2+1     
13200	      M4=N1+NPAR-1      
13300	      DO 232N1=M1,M2      
13400	      M5=N1-M1+1  
13500	 232  RNT(N1)=P(M5)
13600	      RNT(M1  )=P3
13700		RNT(M1+3)=PINCR/P4
13800	C CONVERTS 'P2' TO PROPER INCREMENT FOR DURATIONS.
13900		IF(M3.GT.M4)GO TO 236
14000	      DO 233 N1=M3,M4      
14100	 233  RNT(N1)=0     
14200	236      DO 235 N1=1,NINS      
14300	      IF(TI(N1)-90909.)235,234,235   
14400	 234  TI(N1)=P2+P4   
14500	      ITI(N1)=M1  
14600	      GO TO 204     
14700	 235  CONTINUE    
14800	      CALL ERROR(3)
14900	      GO TO 204     
15000	
15100	C     DEFINE INSTRUMENT  
15200	 2    M1=I2     
15300	      M2=IFIX(P3)
15400		IF(M2.GT.15)PAUSE ' ***** INS NUMBER IS TOO HIGH.'
15500	      IDEF(M2)=M1    
15600	218   CALL DATA (ID21)  
15700		IF(I1.GT.2)GO TO 211
15800	 210  INS(M1)=0     
15900	      I2=M1+1   
16000	C END OF INST. DEF.
16100	      GO TO 204     
16200	211	INS(M1)=P3
16300	C P3 IS UNIT GENERATOR CODE NUM.
16400	      INS(M1+1)=M1+I1-1    
16500	C I1 IS WDCNT OF LAST READIN
16600	      M1=M1+2     
16700	      DO 217N1=4,I1
16800	      M5=P(N1)    
16900	      IF(M5)212,213,213  
17000	 212  IF(M5+100)300,301,301     
17100	 300  INS(M1)=-1+(M5+101)*LFUNC      
17200	      GO TO 216     
17300	 301  INS(M1)=-1+(M5+1)*LBLK      
17400	      GO TO 216     
17500	213	INS(M1)=M5
17600	 216  M1=M1+1     
17700	 217  CONTINUE    
17800		GO TO 218
17900	
18000	C     PLAY TO ACTION TIME
18100	 244  T2=P2   
18200	 250  TMIN=90909.    
18300	      IREST=1     
18400	      DO 241N1=1,NINS      
18500	      IF(TMIN-TI(N1))241,241,240
18600	 240  TMIN=TI(N1) 
18700	      MNOTE=N1    
18800	 241  CONTINUE    
18900	      IF(90909.-TMIN)251,251,243     
19000	 243  IF(TMIN-T2)245,245,246  
19100	 245  T3=TMIN   
19200	      GO TO 260     
19300	 246  T3=T2   
19400	      GO TO 260     
19500	 247  IF(T(1)-T2)249,200,200  
19600	 249  TI(MNOTE)=90909.
19700	      M2=ITI(MNOTE)      
19800	      RNT(M2)=-1    
19900	      GO TO 250     
20000	
20100	C     SETUP REST  
20200	 251  T3=T2   
20300	      IREST=2     
20400	      GO TO 260     
20500	
20600	C     PLAY 
20700	 260  SMPLS=(T3-T(1))*SRATE
20800	C SMPLS MUST BE FLOATING PT. (OR DOUBLE PRECISION)
20900	CCC 260  ISAM=(T3-T(1))*FLOAT(I4)+.5  
21000	      T(1)=T3   
21100	      IF(SMPLS.LE.0.5)GO TO 247   
21200	 266  IF(SMPLS-RBLK.GT.0.5)GO TO 263
21300	 262  I5=SMPLS   
21400	      SMPLS=0      
21500	CCC   IF(ISAM)247,247,266
21600	CCC 266  IF(ISAM-LBLK)262,262,263
21700	CCC 262  I5=ISAM   
21800	CCC      ISAM=0      
21900	      GO TO 264     
22000	 263  I5=LBLK 
22100	      SMPLS=SMPLS-RBLK   
22200	C LBLK AND RBLK ARE EQUAL
22300	CCC   ISAM=ISAM-LBLK   
22400	 264  IF(I(8))290,290,291
22500	 290  M3=MOUT+I5-1     
22600	      MSAMP=I5  
22700	      GO TO 292     
22800	 291  M3=MOUT+(2*I5)-1 
22900	      MSAMP=2*I5
23000	 292  DO 267N1=MOUT,M3    
23100	 267  ROUT(N1)=0     
23200	      GO TO (268,265),IREST
23300	
23400	 268  DO 270 NS1=1,NLIM,NPAR      
23500	      IF(RNT(NS1)+1)271,270,271   
23600	C     GO THROUGH UNIT GENERATORS IN INSTRUMENT
23700	 271  I3=NS1    
23800	      IGEN=RNT(NS1)  
23900	      IGEN=IDEF(IGEN)  
24000	 272  I6=IGEN   
24100	 294  CALL FORSAM  
24200	 295  IGEN=INS(IGEN+1)     
24300	      IF(INS(IGEN))270,270,272    
24400	 270  CONTINUE    
24500	 265  CALL SAMOUT(IDSK ,MSAMP)
24600	      IF(SMPLS-0.5)247,247,266
24700	CCC   IF(ISAM)247,247,266
24800	      END  
24900	
25000	CDATA3     PASS 3 DATA INPUTING ROUTINE
25100	      SUBROUTINE DATA (N)
25200	      COMMON I(1)/P/ P(1) /FINOUT/JPEAK,IPEAK /IFIRST/IFIRST,IDT
25300		COMMON /DEVS/ID1,ID21,JTYPE,KIN,KOUT /JP/JPRNT 
25400		EQUIVALENCE (K,I),(P2,P(2))
25500		CALL TRANS(IDT)
25600		IF(JPRNT.LT.0)GO TO 3
25700	C DON'T TYPE BEGIN TIMES IF INPUT IS BEING TYPED OUT. (JPRNT=-1)
25800		IF(P(1).EQ.1)WRITE(JTYPE,1)P2
25900	3	IF(IPEAK.LE.JPEAK)RETURN
26000		WRITE(JTYPE,2)IPEAK
26100		JPEAK=IPEAK
26200	C  TYPES OUT EACH NEW PEAK AMPL.
26300	      RETURN      
26400	1	FORMAT('+',F9.2,$)
26500	2	FORMAT(/' AMPL=',I5,$)
26600	      END  
26700	
26800	      SUBROUTINE FROUT3(IDSK) 
26900	C   TERMINATE OUTPUT     
27000		COMMON /DEVS/ID1,ID21,JTYPE,ID23,KOUT 
27100		COMMON  /ROUT/ROUT(1)  /FINOUT/JPEAK,IPEAK /CONV/ICONV 
27200		DO 1 K=1,512
27300	1	ROUT(K)=0
27400	      CALL SAMOUT(IDSK,512)
27500		IF(JPEAK.LT.IPEAK)JPEAK=IPEAK
27600	      WRITE(JTYPE,10)JPEAK
27700	C NOW CLOSE OFF THE FILE
27800		IF(ICONV.LT.0)GO TO 3
27900		CALL CLOSIT(ID23)
28000		CALL EXIT
28100		RETURN
28200	  3	CALL FINEXT
28300	C****** TEMPORARY *********
28400		IF(KTYPE.EQ.0)GO TO 2
28500		COMMON I(513)
28600		COMMON /INS/INS(300),IDEF(15) /NT/RNT(700)
28700		CALL OFILE(24,'SAM')
28800		WRITE(24,4)IDEF
28900		WRITE(24,4)INS
29000		WRITE(24,5)RNT
29100		WRITE(24,4)I
29200		CALL EXIT
29300	4	FORMAT(8I10)
29400	
29500	5	FORMAT(8F10.4)
29600	2	CALL PLAY
29700		RETURN    
29800	10    FORMAT (/' PEAK AMPLITUDE WAS ',I6)
29900	      END